home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / 2dRect.cls < prev    next >
Text File  |  1999-06-17  |  5KB  |  149 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "TwoDRectangle"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. ' Two-dimensional rectangle object.
  16.  
  17. Implements TwoDObject
  18.  
  19. Public X1 As Single
  20. Public Y1 As Single
  21. Public X2 As Single
  22. Public Y2 As Single
  23.  
  24. ' Drawing properties.
  25. Private m_DrawWidth As Integer
  26. Private m_DrawStyle As DrawStyleConstants
  27. Private m_ForeColor As OLE_COLOR
  28. Private m_FillColor As OLE_COLOR
  29. Private m_FillStyle As FillStyleConstants
  30.  
  31. Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  32.  
  33. ' Draw the object in a metafile.
  34. Private Sub TwoDObject_DrawInMetafile(ByVal mf_dc As Long)
  35.     SetMetafileDrawingParameters Me, mf_dc
  36.  
  37.     Rectangle mf_dc, X1, Y1, X2, Y2
  38.  
  39.     RestoreMetafileDrawingParameters mf_dc
  40. End Sub
  41. ' Return the object's DrawWidth.
  42. Public Property Get TwoDObject_DrawWidth() As Integer
  43.     TwoDObject_DrawWidth = m_DrawWidth
  44. End Property
  45. ' Set the object's DrawWidth.
  46. Public Property Let TwoDObject_DrawWidth(ByVal new_value As Integer)
  47.     m_DrawWidth = new_value
  48. End Property
  49.  
  50. ' Return the object's DrawStyle.
  51. Public Property Get TwoDObject_DrawStyle() As DrawStyleConstants
  52.     TwoDObject_DrawStyle = m_DrawStyle
  53. End Property
  54. ' Set the object's DrawStyle.
  55. Public Property Let TwoDObject_DrawStyle(ByVal new_value As DrawStyleConstants)
  56.     m_DrawStyle = new_value
  57. End Property
  58.  
  59. ' Return the object's ForeColor.
  60. Public Property Get TwoDObject_ForeColor() As OLE_COLOR
  61.     TwoDObject_ForeColor = m_ForeColor
  62. End Property
  63. ' Set the object's ForeColor.
  64. Public Property Let TwoDObject_ForeColor(ByVal new_value As OLE_COLOR)
  65.     m_ForeColor = new_value
  66. End Property
  67.  
  68. ' Return the object's FillColor.
  69. Public Property Get TwoDObject_FillColor() As OLE_COLOR
  70.     TwoDObject_FillColor = m_FillColor
  71. End Property
  72. ' Set the object's FillColor.
  73. Public Property Let TwoDObject_FillColor(ByVal new_value As OLE_COLOR)
  74.     m_FillColor = new_value
  75. End Property
  76.  
  77. ' Return the object's FillStyle.
  78. Public Property Get TwoDObject_FillStyle() As FillStyleConstants
  79.     TwoDObject_FillStyle = m_FillStyle
  80. End Property
  81. ' Set the object's FillStyle.
  82. Public Property Let TwoDObject_FillStyle(ByVal new_value As FillStyleConstants)
  83.     m_FillStyle = new_value
  84. End Property
  85.  
  86. ' Return this object's bounds.
  87. Public Sub TwoDObject_Bound(ByRef xmin As Single, ByRef xmax As Single, ByRef ymin As Single, ByRef ymax As Single)
  88.     If X1 < X2 Then
  89.         xmin = X1
  90.         xmax = X2
  91.     Else
  92.         xmin = X2
  93.         xmax = X1
  94.     End If
  95.     If Y1 < Y2 Then
  96.         ymin = Y1
  97.         ymax = Y2
  98.     Else
  99.         ymin = Y2
  100.         ymax = Y1
  101.     End If
  102. End Sub
  103. ' Draw the object on the canvas.
  104. Public Sub TwoDObject_Draw(ByVal canvas As Object)
  105.     SetCanvasDrawingParameters Me, canvas
  106.     canvas.Line (X1, Y1)-(X2, Y2), , B
  107. End Sub
  108. ' Initialize the object using a serialization string.
  109. ' The serialization does not include the
  110. ' ObjectType(...) part.
  111. Private Property Let TwoDObject_Serialization(ByVal RHS As String)
  112. Dim token_name As String
  113. Dim token_value As String
  114.  
  115.     InitializeDrawingProperties Me
  116.  
  117.     ' Read tokens until there are no more.
  118.     Do While Len(RHS) > 0
  119.         ' Read a token.
  120.         GetNamedToken RHS, token_name, token_value
  121.         Select Case token_name
  122.             Case "X1"
  123.                 X1 = CSng(token_value)
  124.             Case "Y1"
  125.                 Y1 = CSng(token_value)
  126.             Case "X2"
  127.                 X2 = CSng(token_value)
  128.             Case "Y2"
  129.                 Y2 = CSng(token_value)
  130.             Case Else
  131.                 ReadDrawingPropertySerialization Me, token_name, token_value
  132.         End Select
  133.     Loop
  134. End Property
  135.  
  136. ' Return a serialization string for the object.
  137. Public Property Get TwoDObject_Serialization() As String
  138. Dim txt As String
  139.  
  140.     txt = DrawingPropertySerialization(Me)
  141.     txt = txt & " X1(" & Format$(X1) & ")"
  142.     txt = txt & " Y1(" & Format$(Y1) & ")"
  143.     txt = txt & " X2(" & Format$(X2) & ")"
  144.     txt = txt & " Y2(" & Format$(Y2) & ")"
  145.     TwoDObject_Serialization = "TwoDRectangle(" & txt & ")"
  146. End Property
  147.  
  148.  
  149.